home *** CD-ROM | disk | FTP | other *** search
/ TOS Silver 2000 / TOS Silver 2000.iso / programm / MM2_DEV / S / UTILITY / MODLOAD.M < prev    next >
Encoding:
Text File  |  1991-02-28  |  37.2 KB  |  1,022 lines
  1. MODULE ModLoad; (*$E MAC  -> Linker erzeugt ACC-Endung *)
  2.  
  3. (*
  4.  * Loadtime Linker zum Starten der Module ohne die MM2Shell.
  5.  *
  6.  * Wird dieses Modul gelinkt (Treiber: "M2Init", "GEMIO" oder ein anderer
  7.  * InOut-Treiber; Optimierung: keine oder nur Prozedurnamen entfernen),
  8.  * kann es vom Desktop gestartet (Endung PRG oder APP) oder als Accessory
  9.  * mit der Endung ACC auf das Bootlaufwert installiert werden.
  10.  *
  11.  * Dabei bleibt es resident und hängt sich in den GEMDOS-Trap-Handler ein,
  12.  * um die Pexec-Aufrufe zu überwachen. Damit allerdings importierte Module
  13.  * gefunden werden, müssen noch die Pfade, auf denen auf dem verwendeten
  14.  * Rechner-System die Code-Module liegen, im lokalen Modul 'MyPaths' (s.u.,
  15.  * Aufrufe der Prozedur 'append') eingetragen werden.
  16.  *
  17.  * So ist es möglich, alle Megamax-Module unter dem Desktop oder auch von
  18.  * anderen Programmen aus (z.B. GEMINI) zu starten. Dies erspart dem Anwender,
  19.  * die Module extra zu PRG-Dateien zusammenzulinken.
  20.  * Besonders für Anwender ohne Festplatte läßt sich das oft benötigte Starten
  21.  * der Modula-Shell vereinfachen. Dazu muß die MM2Shell nur zu einem Modul
  22.  * compiliert werden. Sie kann dann zusammen mit Compiler und Editor resident
  23.  * gemacht (geladen) werden. Wird die Shell verlassen, wird ein erneuter
  24.  * Aufruf der Shell innerhalb von 2-3 Sekunden durchgeführt (lediglich die
  25.  * Resource-Datei und die Parameter- und Batch-Dateien müssen noch jedesmal
  26.  * geladen werden).
  27.  *
  28.  * Damit die Module vom Desktop aus zu starten sind, müssen sie als Programm-
  29.  * dateien ausgewiesen werden. Dazu sind mit einem Editor (nicht den Gepard-
  30.  * Editor verwenden!) in die Datei 'DESKTOP.INF' folgende Zeilen einzufügen
  31.  * (ohne die Anführungszeichen - vergleiche die schon darin existierenden
  32.  * Zeilen f. 'PRG', 'TOS', usw!):
  33.  *
  34.  * "#G 03 FF   *.MOD@ @ "  bestimmt ausführbare GEM-Programme;
  35.  * "#F 03 04   *.MOS@ @ "  bestimmt ausführbare TOS-Programme;
  36.  * "#P 03 04   *.MTP@ @ "  bestimmt ausführbare TTP-Programme.
  37.  *
  38.  * Beim Neustart des Rechners sollten dann alle Module auf dem Desktop mit
  39.  * dem Programm-Symbol angezeigt werden. Ist ModLoad installiert, kann
  40.  * jedes andere Modul vom Desktop aus mit einem Doppelklick gestartet werden
  41.  * (z.B. der Compiler).
  42.  *
  43.  * Sollen Module, wie z.B. die Shell, geladen werden, ist beim Doppelklick
  44.  * die Control-Taste festzuhalten; bei Freigabe ist ebenfalls auf das ge-
  45.  * wünschte Modul doppelt zu klicken und sowohl die Control- als auch die
  46.  * linke Shift-Taste zu drücken. Beides kann natürlich auch über die als
  47.  * Modul gestartete Shell in gewohnter Weise durchgeführt werden: MM2Shell
  48.  * kann sich sowohl selbst 'laden' als daß sie auch wieder 'entladen'
  49.  * werden kann, indem sie aus dem Resident-Fenster in den Mülleimer gezogen
  50.  * wird - dann wird zwar angezeigt, das Modul wäre nicht freigegeben worden,
  51.  * aber das liegt ja auch daran, daß die Shell noch aktiv ist - sobald sie
  52.  * aber verlassen wird, wird sie auch freigegeben und beim nächsten Start
  53.  * muß sie wieder von Disk gelesen werden.
  54.  *
  55.  * Beim Start des Programms liest es die Datei "MODLOAD.INF", die sich im
  56.  * selben Verzeichnis wie ModLoad befinden muß. Darin können Module und
  57.  * Programme zeilenweise aufgelistet werden, die ModLoad dann automatisch
  58.  * lädt. Die Module müssen ggf. mit vollst. Pfad und Endung angegeben sein.
  59.  * Werden die später benötigten Module gleich beim Start von ModLoad über
  60.  * die INF-Datei geladen, kann nebenbei auch ein übermäßiges Zerstückeln
  61.  * des freien Speichers vermieden werden.
  62.  *
  63.  * Übrigens: Natürlich können auch normale, gelinkte Programme geladen
  64.  * werden - ganz wie in der Shell. Das liegt daran, daß für die ganze
  65.  * Programm-/Modulverwaltung einfach der Loader benutzt wird.
  66.  *
  67.  * Wird 'TOS Fehler #35' (oder so) beim Doppelklick eines Moduls angezeigt,
  68.  * so ist dieses Programm (ModLoad) nicht installiert.
  69.  *
  70.  * Da das alles natürlich viel Speicher verschlingt, kann auch alles wieder
  71.  * bei Belieben freigegeben werden, indem 'MODLOAD.PRG' erneut durch Doppel-
  72.  * klick gestartet wird (geht nicht, wenn ModLoad als Accessory installiert
  73.  * ist oder beim TOS auf dem TT). Dabei dürfte kein Diskzugriff stattfinden
  74.  * und danach sind alle Module inclusive ModLoad wieder entfernt.
  75.  *
  76.  * Dies Programm könnte noch verbessert werden: Es könnte die Pfadliste
  77.  * aus einer Datei lesen, auch könnten darin Module/Programme eingetragen
  78.  * sein, die automatisch beim Start geladen werden.
  79.  * Wenn man die Funktionen der MM2Shell, wie die das Setzen der Parameter
  80.  * für Compiler, Linker usw, durch kleine Programme ersetzt, kann völlig
  81.  * auf die MM2Shell verzichtet werden - dann kann jede beliebige Shell
  82.  * als Entwicklungsumgebung verwendet werden, ohne auf die Vorteile des
  83.  * Loadtime Linkings und der Laufzeitumgebung verzichten zu müssen.
  84.  * Als alternative Shell bietet sich besonders das Shareware-Produkt
  85.  * "GEMINI" an.
  86.  *
  87.  * Wenn Sie dieses Programm erweitert oder Sie gar ein paar Hilfsprogramme
  88.  * für die Arbeit mit anderen Shells erstellt haben, wenden Sie sich doch
  89.  * bitte damit an uns (oder den Vertrieb), wir würden es gerne auch anderen
  90.  * MM2-Anwendern zukommen lassen (z.B. über den MeMoX-Service).
  91.  *
  92.  * Wenn Sie eine Shell-Einbindung vorhaben, sich das aber nicht allein
  93.  * zutrauen, dann wenden Sie sich erst recht an uns! Wir freuen uns, Ihnen
  94.  * dabei unter die Arme zu greifen. Megamax Modula-2 ist schließlich mit
  95.  * genau dieser Philosophie entwickelt worden: Wir wollen Ihnen mit unserem
  96.  * Know-How beim Programmieren die bestmögliche Unterstützung bieten!
  97.  *
  98.  *----------------------------------------------------------------------------
  99.  * 22.10.88  TT       Grunderstellung
  100.  * 21.12.88  TT  1.0  Fertigstellung mit Doku
  101.  * 04.07.89  TT  1.1  Läuft nun fehlerfrei mit neuem Loader/ModBase/ModCtrl
  102.  *                      vom 4.7.89.
  103.  * 03.05.90  TT  1.2  Anpassung an System 2.2
  104.  * 17.08.90  TT       $Y+ hinzugefügt
  105.  * 10.11.90  TT       XBRA-Kennung "ModL" eingefügt.
  106.  * 21.11.90  TT  1.3  Modul 'GEMError' eingefügt; kleine Korrekturen; nun auch
  107.  *                    als Accessory installierbar (einfach Endung auf .ACC
  108.  *                    ändern); Stack für Loader wird per Malloc() reserviert,
  109.  *                    so daß es keine Probleme mehr mit dem Stack geben dürfte;
  110.  *                    die Datei "MODLOAD.INF" wird eingelesen und alle darin
  111.  *                    enthaltenen Dateien als Module/Programme geladen.
  112.  * 28.02.91  TT  1.4  Läuft nun auch auf dem Atari TT / hyperCACHE 030.
  113.  *                    Unterstützt ARGV-Methode.
  114.  *)
  115.  
  116. (*$Y+,R-,S-*)
  117.  
  118. FROM SYSTEM IMPORT
  119.   CADR, ASSEMBLER, CAST, ADDRESS, ADR, TSIZE, BYTE, WORD, LONGWORD;
  120.  
  121. IMPORT BIOS, XBIOS;
  122.  
  123. FROM SysInfo IMPORT
  124.   UseStackFrame;
  125.  
  126. FROM AESWindows IMPORT
  127.   UpdateWindow;
  128.  
  129. FROM ModCtrl IMPORT
  130.   GetOwnName, FirstModuleStart, ReleaseModule, InstallModule;
  131.  
  132. FROM MOSGlobals IMPORT
  133.   MemArea;
  134.  
  135. FROM StorBase IMPORT
  136.   FullStorBaseAccess, MemSize;
  137.  
  138. FROM Storage IMPORT ALLOCATE;
  139.  
  140. IMPORT Strings;
  141.  
  142. FROM FileNames IMPORT
  143.   SplitPath, SplitName;
  144.  
  145. FROM Console IMPORT
  146.   Write, WriteLn, WriteString, KeyPressed, FlushKbd;
  147.  
  148. FROM AESMisc IMPORT
  149.   ShellFind;
  150.  
  151. FROM Files IMPORT
  152.   File, Open, Close, EOF, State, Access;
  153.  
  154. FROM Text IMPORT
  155.   ReadString, ReadLn;
  156.  
  157. FROM Loader IMPORT
  158.   DefaultStackSize, LoadModule, UnLoadModule, CallModule, LoaderResults;
  159.  
  160. FROM AESWindows IMPORT
  161.   DeskHandle, ScreenBuffer;
  162.  
  163. FROM GEMEnv IMPORT
  164.   GemActive, GemError, InitApplication, ExitApplication;
  165.  
  166. FROM EasyGEM0 IMPORT
  167.   FormAlert, WrapAlert;
  168.  
  169. FROM AESEvents IMPORT MessageEvent, MessageBuffer, accOpen;
  170. FROM AESMenus IMPORT RegisterAcc;
  171. FROM PrgCtrl IMPORT Accessory;
  172.  
  173. FROM MOSCtrl IMPORT
  174.   ProcessID, ModLevel, PtrPDB, GetPDB;
  175.  
  176. IMPORT XBRA, Lists, PrgCtrl;
  177.  
  178. IMPORT MOSGlobals, SystemError, SysBuffers, SysTypes, FileBase, Files,
  179.        StrConv, ResCtrl, HdlError, ErrBase, MOSConfig, SysCtrl, ShellMsg,
  180.        GEMScan;
  181.  
  182.  
  183. CONST  LoaderStackSize = 16000; (* Stackgröße für Aufruf des Loaders *)
  184.  
  185.        Kennung = 'ModL';  (* XBRA-Kennung *)
  186.  
  187.        MyName = "ModLoad";
  188.  
  189.  
  190. MODULE GEMError;
  191.  
  192. (*
  193.  * lokales Modul. Kopie aus "GEMERROR.I"
  194.  *)
  195.  
  196. IMPORT MOSGlobals, SystemError, ALLOCATE;
  197. FROM MOSGlobals IMPORT MEM, MemArea, BusFault, OddBusAddr, NoValidRETURN,
  198.         OutOfStack;
  199. FROM SysBuffers IMPORT HdlErrorStack;
  200. IMPORT FormAlert;
  201. IMPORT InitApplication, ExitApplication;
  202. FROM Strings IMPORT String, Pos, Delete, Assign, Insert, Concat, Copy, Length,
  203.         Empty, Space, Append, Upper;
  204. IMPORT ASSEMBLER, LONGWORD, WORD, ADDRESS, BYTE, ADR;
  205. FROM SysTypes IMPORT ExcDesc, ScanDesc;
  206. FROM FileBase IMPORT CloseFile, HandleError;
  207. FROM Files IMPORT File, ResetState, Close, Remove, GetStateMsg, State,
  208.                 GetFileName;
  209. FROM StrConv IMPORT CardToStr, StrToLCard, IntToStr, LHexToStr;
  210. FROM PrgCtrl IMPORT TermProcess, EnvlpCarrier, SysSetEnvelope;
  211. FROM ResCtrl IMPORT RemovalCarrier, CatchRemoval;
  212. FROM HdlError IMPORT GetErrorMsg, ReleaseCatcher, CatchErrors;
  213. FROM ErrBase IMPORT RemoveExc, RtnCond, ErrResp;
  214. FROM MOSConfig IMPORT LoaderMsg, RuntimeErrMsg, FileErrMsg;
  215. FROM ShellMsg IMPORT ScanMode, ScanAddr, TextName, ErrorMsg, DefPaths,
  216.         ModPaths, Active, ScanIndex, ImpPaths, SrcPaths;
  217. FROM GEMScan IMPORT InputScan, InitChain, CallingChain;
  218. IMPORT ModLevel;
  219. FROM SysCtrl IMPORT ExcToScanAddr;
  220.  
  221. VAR strVal:BOOLEAN;
  222.  
  223. PROCEDURE prepare (VAR msg: ARRAY OF CHAR; mayCont: BOOLEAN; index: CARDINAL;
  224.                    VAR mayEdit: BOOLEAN);
  225.   BEGIN
  226.     Insert ('[0][',0,msg,strVal);
  227.     Append ('][Quit',msg,strVal);
  228.     IF mayCont THEN
  229.       Append ('|Cont',msg,strVal)
  230.     END;
  231.     mayEdit:= Active & (ModLevel>1) & ~Empty (CallingChain [index].modName);
  232.     IF mayEdit THEN
  233.       Append ('|Scan',msg,strVal)
  234.     END;
  235.     Append (']',msg,strVal);
  236.   END prepare;
  237.  
  238.  
  239. (* Folgende Funktion fängt allgemeine Laufzeitfehler ab. *)
  240.  
  241. PROCEDURE bye(nr: INTEGER; msg: ARRAY OF CHAR; causer: ErrResp;
  242.               cont: RtnCond; VAR info: ExcDesc): BOOLEAN;
  243.   
  244.   VAR scan: ScanDesc;
  245.       msg1:ARRAY [0..133] OF CHAR; (* reicht f. 4 Zeilen *)
  246.       showAddr,
  247.       mayCont,
  248.       mayEdit: BOOLEAN;
  249.       defBut, index, button:CARDINAL;
  250.       relad:LONGCARD;
  251.       str,
  252.       mname:ARRAY [0..31] OF CHAR;
  253.   BEGIN
  254.     (* Fehlermeldung vorbereiten *)
  255.     IF Empty (msg) THEN  (* Wurde ein Text übergeben? *)
  256.       GetErrorMsg (nr,str) (* Nein, dann Standardtext verwenden *)
  257.     ELSE
  258.       Assign (msg,str,strVal)
  259.     END;
  260.     (* bei Bus- und Adreßfehlern soll auch die Zugriffsadr. angezeigt werden:*)
  261.     showAddr:= (nr=BusFault) OR (nr=OddBusAddr);
  262.     (* Scanner-Record vorbereiten: *)
  263.     ExcToScanAddr (info, scan);
  264.     (* Start-Tiefe bei Scanner-Anzeige festlegen *)
  265.     IF causer=callerCaused THEN
  266.       index:= 1
  267.     ELSE
  268.       index:= 0
  269.     END;
  270.     mayCont:= cont=mayContinue;
  271.     (*
  272.      * Nun Text für FormAlert-Meldung bei 'InputScan' vorbereiten
  273.      *)
  274.     IF showAddr THEN
  275.       Concat (str,'| auf ',msg1,strVal);
  276.       Append (LHexToStr(info.accessAddr,0),msg1,strVal)
  277.     ELSE
  278.       Assign (str,msg1,strVal)
  279.     END;
  280.     (* Aufruferkette erstellen *)
  281.     InitChain (scan);
  282.     (* Scanner starten *)
  283.     InputScan (msg1,index);
  284.     (*
  285.      * Nun Meldung "Quit|Cont|Scan" vorbereiten und anzeigen
  286.      *)
  287.     Append ( Space (22 - INTEGER (Length (str))), msg1, strVal);
  288.     prepare (msg1, mayCont, index, mayEdit);
  289.     FormAlert (1+ORD(mayEdit)+ORD(mayCont), msg1, button);
  290.     (*
  291.      * Zuletzt Programm beenden, fortführen oder Scanning des Compilers starten
  292.      *)
  293.     IF button = 2+ORD(mayCont) THEN (* Scan *)
  294.       (* f. Scanning des Compilers werden einige Vars gesetzt, damit *
  295.        * die Shell bei Programmrückkehr sofort die Aktion startet.   *)
  296.       ScanMode := TRUE;
  297.       ScanIndex:= index;
  298.       Assign (str,ErrorMsg,strVal);
  299.       TermProcess (nr)
  300.     ELSIF button = 1 THEN (* Quit *)
  301.       TermProcess (nr)
  302.     ELSE (* Cont *)
  303.       RETURN FALSE
  304.     END
  305.   END bye;
  306.  
  307.  
  308. (* Folgende Prozedur fängt Dateifehler ab. *)
  309.  
  310. PROCEDURE handleError0 (VAR f:File; errNo: INTEGER; scan: ScanDesc);
  311.   VAR index,retBut:CARDINAL;
  312.       mayEdit: BOOLEAN;
  313.       name: ARRAY [0..23] OF CHAR;
  314.       str: ARRAY [0..31] OF CHAR;
  315.       msg:ARRAY [0..109] OF CHAR;
  316.   BEGIN
  317.     GetStateMsg (errNo,str);
  318.     Concat ('Dateifehler:|',str,msg,strVal);
  319.     InitChain (scan);
  320.     index:= 1;
  321.     InputScan (msg,index);
  322.     Append ("|Datei: ",msg,strVal);
  323.     GetFileName (f,name);
  324.     Append (name,msg,strVal);
  325.     prepare (msg, TRUE, index, mayEdit);
  326.     FormAlert (2+ORD(mayEdit), msg, retBut);
  327.     IF retBut = 1 THEN
  328.       TermProcess (MOSGlobals.FileSystemErr)
  329.     ELSIF retBut = 3 THEN
  330.       ScanMode := TRUE;
  331.       ScanIndex:= index;
  332.       Assign (str,ErrorMsg,strVal);
  333.       TermProcess (MOSGlobals.FileSystemErr)
  334.     ELSE
  335.       ResetState (f)
  336.     END
  337.   END handleError0;
  338.  
  339.  
  340. (* Folgende Prozedur zeigt bei Prozeßende offen gebliebene Dateien an. *)
  341.  
  342. PROCEDURE closeFile0 (f: File; new:BOOLEAN);
  343.   VAR res: INTEGER;
  344.       retBut:CARDINAL;
  345.       msg1,msg: ARRAY [0..99] OF CHAR;
  346.       name: ARRAY [0..23] OF CHAR;
  347.       ch: CHAR;
  348.       strVal:BOOLEAN;
  349.   BEGIN
  350.     GetFileName (f,name);
  351.     Concat ('Datei ',name,msg,strVal);
  352.     Append ('|wurde nicht geschlossen.',msg,strVal);
  353.     IF new THEN
  354.       msg1 := '[1][][Schließen|Löschen]';
  355.     ELSE
  356.       msg1 := '[1][][Schließen]';
  357.     END;
  358.     Insert (msg,4,msg1,strVal);
  359.     FormAlert (1,msg1,retBut);
  360.     IF retBut=1 THEN
  361.       Close (f);
  362.       res:= State (f);
  363.       IF res<0 THEN
  364.         GetStateMsg (res,msg);
  365.         Insert ("[1][Fehler beim Schließen:|",0,msg,strVal);
  366.         Append ("][ OK ]",msg,strVal);
  367.         FormAlert (1,msg,retBut)
  368.       END
  369.     ELSE
  370.       Remove (f)
  371.     END
  372.   END closeFile0;
  373.  
  374.  
  375. (* Folgende Prozedur dient als Datenfeld mit allen Dateifehlertexten. *)
  376.  
  377. PROCEDURE fileMessages;
  378.   (*$L- : keinen Eingangscode erzeugen. *)
  379.   BEGIN
  380.     ASSEMBLER
  381. (* deutsche Meldungen: *)
  382.         DC.W    32767  ; default für undefinierte positive Fehlernummern:
  383.                         ACZ 'Undefinierte Warnung: @'  ASC '        '
  384.         DC.W    MOSGlobals.fNotDeleted
  385.                         ACZ 'Datei war nicht vorhanden'  ASC '      '
  386.         DC.W    MOSGlobals.fWasNotOpen
  387.                         ACZ 'Datei war nicht geöffnet'  ASC '       '
  388.         DC.W    MOSGlobals.fEOF
  389.                         ACZ 'Dateiende erreicht'  ASC '             '
  390.         DC.W    MOSGlobals.fEOL
  391.                         ACZ 'Zeilenende erreicht'  ASC '            '
  392.         DC.W    MOSGlobals.fOK
  393.                         ACZ 'Kein Fehler'  ASC '                    '
  394.         DC.W    MOSGlobals.fError
  395.                         ACZ 'Allgemeiner Fehler'  ASC '             '
  396.         DC.W    MOSGlobals.fDriveNotReady
  397.                         ACZ 'Laufwerk nicht ansprechbar'  ASC '     '
  398.         DC.W    MOSGlobals.fUnknownCmd
  399.                         ACZ 'Unbekannte Funktion'  ASC '            '
  400.         DC.W    MOSGlobals.fCRCError
  401.                         ACZ 'Prüfsummenfehler'  ASC '               '
  402.         DC.W    MOSGlobals.fBadRequest
  403.                         ACZ 'Unerlaubte Funktion'  ASC '            '
  404.         DC.W    MOSGlobals.fSeekError
  405.                         ACZ 'Disk defekt'  ASC '                    '
  406.         DC.W    MOSGlobals.fUnknownMedia
  407.                         ACZ 'Unbekanntes Disk-Format'  ASC '        '
  408.         DC.W    MOSGlobals.fSectorNotFound
  409.                         ACZ 'Sektor nicht vorhanden'  ASC '         '
  410.         DC.W    MOSGlobals.fNoPaper
  411.                         ACZ 'Drucker: Papierende'  ASC '            '
  412.         DC.W    MOSGlobals.fWriteFault
  413.                         ACZ 'Schreibfehler'  ASC '                  '
  414.         DC.W    MOSGlobals.fReadFault
  415.                         ACZ 'Lesefehler'  ASC '                     '
  416.         DC.W    MOSGlobals.fGenError
  417.                         ACZ 'Allgemeiner Disk-Fehler'  ASC '        '
  418.         DC.W    MOSGlobals.fWriteProtected
  419.                         ACZ 'Disk ist schreibgeschützt'  ASC '      '
  420.         DC.W    MOSGlobals.fMediaChanged
  421.                         ACZ 'Disk wurde gewechselt'  ASC '          '
  422.         DC.W    MOSGlobals.fUnknownDevice
  423.                         ACZ 'Unbekanntes Gerät o. Laufwerk'  ASC '  '
  424.         DC.W    MOSGlobals.fBadSectorsOnFormat
  425.                         ACZ 'Fehlerhafte Sektoren'  ASC '           '
  426.         DC.W    MOSGlobals.fInsertOtherDisk
  427.                         ACZ 'Disk wechseln (A<->B)'  ASC '          '
  428.         DC.W    MOSGlobals.fInvalidFunctionNr
  429.                         ACZ 'Unerlaubte Funktionsnummer'  ASC '     '
  430.         DC.W    MOSGlobals.fFileNotFound
  431.                         ACZ 'Datei existiert nicht'  ASC '          '
  432.         DC.W    MOSGlobals.fPathNotFound
  433.                         ACZ 'Directory existiert nicht'  ASC '      '
  434.         DC.W    MOSGlobals.fTooManyOpen
  435.                         ACZ 'Zu viele Dateien offen'  ASC '         '
  436.         DC.W    MOSGlobals.fAccessDenied
  437.                         ACZ 'Zugriff verwehrt'  ASC '               '
  438.         DC.W    MOSGlobals.fInvalidHandle
  439.                         ACZ 'Unerlaubte Zugriffskennung'  ASC '     '
  440.         DC.W    MOSGlobals.fInsufficientMemory
  441.                         ACZ 'Zu wenig Speicher'  ASC '              '
  442.         DC.W    MOSGlobals.fInvalidMemBlkAddr
  443.                         ACZ 'Speicherblock existiert nicht'  ASC '  '
  444.         DC.W    MOSGlobals.fInvalidDrive
  445.                         ACZ 'Unerlaubtes Laufwerk'  ASC '           '
  446.         DC.W    MOSGlobals.fDiffDrives
  447.                         ACZ 'Rename: verschiedene Laufwerke'  ASC ' '
  448.         DC.W    MOSGlobals.fNoMoreFiles
  449.                         ACZ 'Keine weiteren Dateien'  ASC '         '
  450.         DC.W    MOSGlobals.fRangeError
  451.                         ACZ 'Bereichsüberschreitung'  ASC '         '
  452.         DC.W    MOSGlobals.fInternalError
  453.                         ACZ 'Interner Fehler'  ASC '                '
  454.         DC.W    MOSGlobals.fBadFormatOfPrg
  455.                         ACZ 'Programmdatei defekt'  ASC '           '
  456.         DC.W    MOSGlobals.fResizeFailure
  457.                         ACZ 'Speicherblock nicht vergrößbar'  ASC ' '
  458.         DC.W    MOSGlobals.fOutOfMem
  459.                         ACZ 'Zu wenig Speicher'  ASC '              '
  460.         DC.W    MOSGlobals.fFileExists
  461.                         ACZ 'Datei existiert schon'  ASC '          '
  462.         DC.W    MOSGlobals.fNoReadAllowed
  463.                         ACZ 'Lesezugriff nicht erlaubt'  ASC '      '
  464.         DC.W    MOSGlobals.fFileNotClosed
  465.                         ACZ 'Datei noch offen'  ASC '               '
  466.         DC.W    MOSGlobals.fFileNotOpen
  467.                         ACZ 'Datei nicht offen'  ASC '              '
  468.         DC.W    MOSGlobals.fInternalErr1
  469.                         ACZ 'Interner Fehler (Pos>Length)'  ASC '   '
  470.         DC.W    MOSGlobals.fInternalErr2
  471.                         ACZ 'Interner Fehler (2)'  ASC '            '
  472.         DC.W    MOSGlobals.fBadOp
  473.                         ACZ 'Zugriff in falschem Modus'  ASC '      '
  474.         DC.W    MOSGlobals.fBadAccess
  475.                         ACZ 'Zugriff nicht erlaubt'  ASC '          '
  476.         DC.W    MOSGlobals.fEndOfFile
  477.                         ACZ 'Dateiende überschritten'  ASC '        '
  478.         DC.W    MOSGlobals.fDoubleUndo
  479.                         ACZ "Wiederholter 'UndoRead'-Aufruf"  ASC ' '
  480.         DC.W    MOSGlobals.fNameTooLarge
  481.                         ACZ 'Dateiname zu lang'  ASC '              '
  482.         DC.W    MOSGlobals.fDiskFull
  483.                         ACZ 'Disk ist voll'  ASC '                  '
  484.         DC.W    MOSGlobals.fIllegalCall
  485.                         ACZ 'Unerlaubter Funktionsaufruf'  ASC '    '
  486.         DC.W    -32768 ; default für undefinierte negative Fehlernummern:
  487.                         ACZ 'Undefinierter Fehler: @'  ASC '        '
  488.         DC.W  0,0       ; Endekennzeichnung für die Liste
  489.     END
  490.   END fileMessages;
  491.   (*$L=*)
  492.  
  493. (* Folgende Prozedur dient als Datenfeld mit allen Laufzeitfehlertexten. *)
  494.  
  495. PROCEDURE errMessages;
  496.   (*$L- : keinen Eingangscode erzeugen. *)
  497.   BEGIN
  498.     ASSEMBLER
  499.         DC.W  -32768  ; default für undefinierte Fehlernummern:
  500.                         ACZ 'Undefinierter Fehler: @'  ASC '        '
  501.         DC.W    MOSGlobals.NoErr
  502.                         ACZ 'Kein Fehler'  ASC '                    '
  503.         DC.W    MOSGlobals.GeneralErr
  504.                         ACZ 'Genereller Fehler'  ASC '              '
  505.         DC.W    MOSGlobals.BusFault
  506.                         ACZ 'Adresse nicht ansprechbar'  ASC '      '
  507.         DC.W    MOSGlobals.OddBusAddr
  508.                         ACZ 'Zugriff auf ungerade Adresse'  ASC '   '
  509.         DC.W    MOSGlobals.IllegalInstr
  510.                         ACZ 'Unbekannte Maschinenanweisung'  ASC '  '
  511.         DC.W    MOSGlobals.DivByZero
  512.                         ACZ 'Division durch Null'  ASC '            '
  513.         DC.W    MOSGlobals.OutOfRange
  514.                         ACZ 'Bereichsüberschreitung'  ASC '         '
  515.         DC.W    MOSGlobals.Overflow
  516.                         ACZ 'Überlauf'  ASC '                       '
  517.         DC.W    MOSGlobals.StringOverflow
  518.                         ACZ 'String-Überlauf'  ASC '                '
  519.         DC.W    MOSGlobals.NoValidRETURN
  520.                         ACZ 'Fehlende RETURN-Anweisung'  ASC '      '
  521.         DC.W    MOSGlobals.OutOfStack
  522.                         ACZ 'Stacküberlauf'  ASC '                  '
  523.         DC.W    MOSGlobals.HALTInstr
  524.                         ACZ 'HALT - Anweisung'  ASC '               '
  525.         DC.W    MOSGlobals.FileSystemErr
  526.                         ACZ 'Fehler im Dateisystem'  ASC '          '
  527.         DC.W    MOSGlobals.OutOfMemory
  528.                         ACZ 'Ungenügend freier Speicher'  ASC '     '
  529.         DC.W    MOSGlobals.IllegalCall
  530.                         ACZ 'Unerlaubter Funktionsaufruf'  ASC '    '
  531.         DC.W    MOSGlobals.CoroutineRtn
  532.                         ACZ 'Rückkehr aus Coroutine'  ASC '         '
  533.         DC.W    MOSGlobals.InternalFault
  534.                         ACZ 'Interner Fehler'  ASC '                '
  535.         DC.W    MOSGlobals.IllegalProcVar
  536.                         ACZ 'Undefinierte PROCEDURE-Var.'  ASC '    '
  537.         DC.W    MOSGlobals.IllegalPointer
  538.                         ACZ 'Uninitialisierte POINTER-Var.'  ASC '  '
  539.         DC.W    MOSGlobals.UserBreak
  540.                         ACZ 'Abbruch durch den Anwender'  ASC '     '
  541.         DC.W    MOSGlobals.IllegalState
  542.                         ACZ 'Interner Statusfehler'  ASC '          '
  543.         DC.W    MOSGlobals.Exception
  544.                         ACZ 'Diverse Exception'  ASC '              '
  545.         DC.W    MOSGlobals.GenFPErr
  546.                         ACZ 'Div. Floating-Point Fehler'  ASC '     '
  547.         DC.W    MOSGlobals.CaseSelectErr
  548.                         ACZ 'Unerfüllte CASE-Anweisung'  ASC '      '
  549.         DC.W    MOSGlobals.ConfigErr
  550.                         ACZ 'Fataler Konfigurationsfehler'  ASC '   '
  551.         DC.W    MOSGlobals.IllegalClosure
  552.                         ACZ 'Zuweisung lokaler Prozedur'  ASC '     '
  553.         DC.W    MOSGlobals.GemErr
  554.                         ACZ 'Fehler bei letztem GEM-Aufruf'  ASC '  '
  555.         DC.W  0,0       ; Endekennzeichnung für die Liste
  556.     END
  557.   END errMessages;
  558.   (*$L=*)
  559.  
  560.  
  561. VAR rHdl: RemovalCarrier;
  562.     level: CARDINAL;
  563.  
  564. PROCEDURE envelope (open, child: BOOLEAN; VAR exitcode: INTEGER);
  565.   VAR appOK: BOOLEAN;
  566.   BEGIN
  567.     IF child THEN
  568.       IF open THEN
  569.         IF level = 0 THEN
  570.           InitApplication (appOK);
  571.           IF NOT appOK THEN
  572.             exitcode:= MOSGlobals.fInternalError
  573.           ELSE
  574.             IF NOT CatchErrors (bye,MEM(HdlErrorStack)) THEN
  575.               exitcode:= MOSGlobals.fInsufficientMemory
  576.             END;
  577.           END;
  578.         END;
  579.         INC (level)
  580.       ELSE
  581.         DEC (level);
  582.         IF level = 0 THEN
  583.           ExitApplication ();
  584.           ReleaseCatcher (bye);
  585.           RemoveExc; (* Exc-Handler wieder entfernen *)
  586.         END
  587.       END
  588.     END
  589.   END envelope;
  590.  
  591. VAR ec: EnvlpCarrier;
  592.  
  593. BEGIN
  594.   level:= 0;
  595.   CloseFile:= closeFile0;
  596.   HandleError:= handleError0;
  597.   FileErrMsg:= ADDRESS (fileMessages);
  598.   RuntimeErrMsg:= ADDRESS (errMessages);
  599.   SysSetEnvelope (ec, envelope, MemArea {NIL,0});
  600.  
  601.   (*
  602.    * Den Exception-Handler, der automatisch vom HdlError-Modul eingerichtet
  603.    * wurde, falls dies Prg nicht als Accessory sondern vom Desktop gestartet
  604.    * wird, erstmal wieder entfernen. Bei Aufruf von 'CatchErrors' (s.o.)
  605.    * wird er automatisch wieder installiert.
  606.    *)
  607.   RemoveExc;
  608.  
  609.   NEW (LoaderMsg);
  610.   IF LoaderMsg = NIL THEN SystemError.OutOfMemory END;
  611.  
  612.   (* Fehlertexte des Moduls 'Loader' in Deutsch: *)
  613.   LoaderMsg^[0]:=  '"@I" nicht vorhanden';
  614.   LoaderMsg^[1]:=  '"@I" beim Importieren in "@C" nicht gefunden';
  615.   LoaderMsg^[2]:=  '"@I" ist defekt';
  616.   LoaderMsg^[3]:=  'Unerlaubte Daten in "@I"';
  617.   LoaderMsg^[4]:=  'Unerlaubtes Layout von "@I"';
  618.   LoaderMsg^[5]:=  'Versionskonflikt zwischen "@I" und "@C"';
  619.   LoaderMsg^[6]:=  'Kein ausreichender Speicherplatz mehr';
  620.   LoaderMsg^[7]:=  '"@I" ist resident und schon initialisiert';
  621.   LoaderMsg^[8]:=  'Unerlaubter Modulname';
  622.   LoaderMsg^[9]:=  'Zu viele verschachtelte Modulaufrufe';
  623.   LoaderMsg^[10]:= 'Programm ist nicht ausführbar';
  624.   LoaderMsg^[11]:= 'Programm nicht gefunden';
  625.   LoaderMsg^[12]:= 'Laufzeitfehler während Initialisierung';
  626.   LoaderMsg^[13]:= 'Laufzeitfehler während Deinitialisierung';
  627.   LoaderMsg^[14]:= '"@I" ist komprimiert';
  628.   LoaderMsg^[15]:= '"@I" hat falsches Real-Format';
  629.   LoaderMsg^[16]:= '"@I": FPU nicht vorhanden';
  630.   LoaderMsg^[17]:= 'Zu viele Module zu initialisieren';
  631.   
  632. END GEMError;
  633.  
  634.  
  635. MODULE MyPaths;
  636.  
  637.   IMPORT ADDRESS, ADR;
  638.   IMPORT MemArea;
  639.   IMPORT Lists, Strings;
  640.  
  641.   EXPORT QUALIFIED init, exit, paths;
  642.  
  643.   CONST   pathSize = 64;  (* -- Dieser Wert darf verändert werden -- *)
  644.           maxPath = 10;   (* -- Dieser Wert darf verändert werden -- *)
  645.  
  646.   VAR     pathArray: ARRAY [1..maxPath] OF ARRAY [0..pathSize] OF CHAR;
  647.           paths: Lists.List;
  648.           err: BOOLEAN;
  649.           idx: CARDINAL;
  650.  
  651.   PROCEDURE append (REF name: ARRAY OF CHAR);
  652.     VAR ok: BOOLEAN;
  653.     BEGIN
  654.       IF Strings.Length (name) >= pathSize THEN
  655.         HALT (* Pfadname ist zu groß ! >> 'pathSize' erhöhen ! *)
  656.       ELSE
  657.         IF idx < maxPath THEN
  658.           INC (idx);
  659.           Strings.Assign (name, pathArray [idx], ok);
  660.           Lists.AppendEntry (paths, ADR(pathArray[idx]), err);
  661.           IF err THEN HALT END
  662.         ELSE
  663.           HALT (* Zuviele Pfadnamen ! >> 'maxPath' erhöhen ! *)
  664.         END
  665.       END
  666.     END append;
  667.  
  668.   PROCEDURE exit;
  669.     VAR dummy: ADDRESS;
  670.     BEGIN
  671.       Lists.ResetList (paths);
  672.       dummy:= Lists.PrevEntry (paths);
  673.       REPEAT
  674.         Lists.RemoveEntry (paths, err)
  675.       UNTIL err;
  676.       Lists.DeleteList (paths, err);
  677.       IF err THEN HALT END
  678.     END exit;
  679.  
  680.   PROCEDURE init;
  681.     BEGIN
  682.       Lists.CreateList (paths, err);
  683.       IF err THEN HALT END;
  684.       idx:= 0;
  685.       append ('.\');              (* Dieser Pfad sollte immer dabei sein *)
  686.       (* Und dann noch weitere Pfade in denen sich IMPs befinden... *)
  687.       append ('D:\NEW\CA\IMP\');
  688.     END init;
  689.  
  690.   END MyPaths;
  691.  
  692.  
  693. TYPE PtrPexecPar = POINTER TO RECORD
  694.                      mode: (loadExec, unused1, unused2, load, exec, create);
  695.                      fileName: ADDRESS;
  696.                      arg: ADDRESS;
  697.                      env: ADDRESS
  698.                    END;
  699.  
  700. VAR
  701.   myUpperName: Strings.String;
  702.   path: ARRAY [0..127] OF CHAR;
  703.   arg: ARRAY [0..128] OF CHAR;
  704.   baseProcess: ADDRESS;
  705.   entry, at: ADDRESS;
  706.   carrier: XBRA.Carrier;
  707.   stackhi: ADDRESS;
  708.   doingPexec: BOOLEAN;
  709.   ok: BOOLEAN;
  710.   stackFrameOffs: SHORTCARD;
  711.  
  712.  
  713.  
  714. PROCEDURE Alert (s: ARRAY OF CHAR; wait: BOOLEAN);
  715.  
  716.   VAR button: CARDINAL;
  717.       ok: BOOLEAN;
  718.       msg: ARRAY [0..250] OF CHAR;
  719.  
  720.   BEGIN
  721.     Strings.Assign (s, msg, ok);
  722.     (*
  723.       (* Meldung als TOS-Text ausgeben *)
  724.       WriteLn;
  725.       WriteString (msg);
  726.       WriteLn;
  727.       IF wait THEN
  728.         WriteString ('Press a key...');
  729.         WriteLn;
  730.         REPEAT UNTIL KeyPressed (); FlushKbd;
  731.       END
  732.     *)
  733.     (* Meldung mit FormAlert-Dialog anzeigen *)
  734.     WrapAlert (msg, 0);
  735.     Strings.Insert ('[0][', 0, msg, ok);
  736.     Strings.Append ('][ OK ]', msg, ok);
  737.     FormAlert (1, msg, button);
  738.   END Alert;
  739.  
  740.  
  741. PROCEDURE release;
  742.   BEGIN
  743.     (* TRAP #1 wieder freigeben *)
  744.     IF XBRA.Installed (Kennung, $84, at) THEN
  745.       XBRA.Remove (at);
  746.     END;
  747.     ReleaseModule;
  748.   END release;
  749.  
  750. PROCEDURE hdlPexec (par: PtrPexecPar; VAR exitCode: LONGINT): BOOLEAN;
  751.   (* Return: FALSE: alte Pexec-Funktion aufrufen, sonst Trap beenden *)
  752.  
  753.   PROCEDURE getArg (dosArg: ADDRESS; VAR txt: ARRAY OF CHAR);
  754.     (*
  755.      * Wandelt Pexec-Argumentzeile in String um
  756.      *)
  757.     BEGIN
  758.       ASSEMBLER
  759.         MOVE.L  dosArg(A6),A0           ; A0: dosArg
  760.         MOVE.L  txt(A6),A1              ; A1: ADR (txt)
  761.         CLR     D0
  762.         MOVE.B  (A0)+,D0                ; Länge der Arg-Zeile
  763.         CMPI.B  #$7F,D0                 ; ARGV-Übergabe?
  764.         BNE     c
  765.         MOVE.B  D0,(A1)+                ; bei ARGV das Längenbyte übernehmen
  766.         BRA     c
  767.       l MOVE.B  (A0)+,(A1)+             ; Zeile kopieren
  768.       c DBRA    D0,l
  769.         CLR.B   (A1)                    ; String-Ende mit 0C abschließen
  770.       END
  771.     END getArg;
  772.  
  773.   VAR fn: POINTER TO ARRAY [0..141] OF CHAR;
  774.       prgname: ARRAY [0..11] OF CHAR;
  775.       sfx: ARRAY [0..2] OF CHAR;
  776.       msg: ARRAY [0..99] OF CHAR;
  777.       result: LoaderResults;
  778.       exitCode2: INTEGER;
  779.       ok: BOOLEAN;
  780.       ch: CHAR;
  781.  
  782.   BEGIN (* hdlPexec *)
  783.     fn:= par^.fileName;
  784.     SplitPath (fn^, path, prgname);
  785.     SplitName (prgname, prgname, sfx);
  786.     Strings.Upper (prgname);
  787.     IF Strings.StrEqual (myUpperName, prgname) THEN
  788.       (* Erneuter Start dieses Programms -> Freigeben *)
  789.       Alert ('ModLoad is de-installed', TRUE);
  790.       IF Accessory () THEN
  791.         Alert ("But the Accessory's memory won't be deallocated", TRUE);
  792.       END;
  793.       release;
  794.       RETURN TRUE
  795.     ELSE
  796.       IF (BIOS.ControlKey IN BIOS.GetKBShift ()) THEN
  797.         IF BIOS.LeftShift IN BIOS.GetKBShift () THEN
  798.           UnLoadModule (prgname, result);
  799.           Strings.Assign (prgname, arg, ok);
  800.           IF result = noError THEN
  801.             Strings.Append (' is unloaded', arg, ok);
  802.           ELSE
  803.             Strings.Append (' has still clients!', arg, ok)
  804.           END;
  805.           Alert (arg, TRUE);
  806.         ELSE
  807.           MyPaths.init;
  808.           LoadModule (fn^, MyPaths.paths, arg, msg, result);
  809.           MyPaths.exit;
  810.           IF result = noError THEN
  811.             Strings.Append (' is loaded', arg, ok)
  812.           ELSE
  813.             Strings.Append (" couldn't be loaded", arg, ok)
  814.           END;
  815.           Alert (arg, TRUE)
  816.         END;
  817.         RETURN TRUE
  818.       ELSE
  819.         getArg (par^.arg, arg);
  820.         MyPaths.init; (* Suchpfade setzen *)
  821.         CallModule (fn^, MyPaths.paths, arg, NIL, exitCode2, msg, result);
  822.         MyPaths.exit;
  823.         IF result = noError THEN
  824.           IF exitCode2 >= 0 THEN
  825.             exitCode:= LONG (exitCode2)
  826.           ELSE
  827.             exitCode:= LONG (exitCode2) + 65536
  828.           END
  829.         ELSIF result = notFound THEN
  830.           exitCode:= -33
  831.         ELSIF result = outOfMemory THEN
  832.           exitCode:= -39
  833.         ELSE
  834.           exitCode:= -1;
  835.           Alert (msg, TRUE)
  836.         END;
  837.         RETURN TRUE
  838.       END;
  839.     END;
  840.   END hdlPexec;
  841.  
  842.  
  843. VAR regStack: ARRAY [1..256] OF WORD; (* Stack für Register-Sicherung (½KB) *)
  844.  
  845. PROCEDURE hdlGemdos;
  846.   (*$L-*)
  847.   BEGIN
  848.     ASSEMBLER
  849.         BTST.B  #5,(A7)         ; War Supervisormode aktiv ?
  850.         BNE.B   super           ; Ja, dann stehen Arg. auf SSP
  851.         MOVE.L  USP,A0
  852.         CMPI.W  #$4B,(A0)       ; Pexec - Funktion ?
  853.         BEQ.B   hdlPexecUser
  854. dos     ; normale GEMDOS-Funktion ausführen
  855.         MOVE.L  entry,A0
  856.         MOVE.L  -4(A0),A0
  857.         JMP     (A0)
  858. super   MOVE.W  stackFrameOffs,D0 ; damit es auch mit einer 68010/20/30 geht
  859.         CMPI.W  #$4B,6(A7,D0.W) ; Pexec - Funktion ?
  860.         BNE.B   dos             ; Nein -> GEMDOS aufrufen
  861.         LEA     6(A7,D0.W),A0   ; Basis d. Argumente nach A0
  862. hdlPexecUser:
  863.         TST.W   doingPexec      ; ist dies der "Pexec" von "CallModule"?
  864.         BEQ     noPexec         ;   nein -> dann werten wir ihn selbst aus.
  865.         
  866.         CLR.W   doingPexec
  867.         BRA     dos             ;   ja -> dann lassen wir ihn zum GEMDOS durch
  868.         
  869. noPexec ; prüfen, ob Prg gestartet & ausgeführt werden soll.
  870.         ADDQ.L  #2,A0
  871.         CMPI    #loadExec,PtrPexecPar.mode(A0)
  872.         BNE     dos
  873.  
  874.         MOVE.L  stackhi,A1      ; neuen SP f. Modula-Funktionen laden
  875.         ; Register auf regStack retten:
  876.         MOVEM.L D1-D7/A2-A6,-(A1)
  877.         MOVE.W  (A7)+,-(A1)     ; SR vom SSP retten
  878.         MOVE.L  (A7)+,-(A1)     ; PC vom SSP retten
  879.         TST.W   stackFrameOffs  ; StackFrame vorhanden?
  880.         BEQ     noSF1           ; nein
  881.         MOVE.W  (A7)+,-(A1)     ; StackFrame vom SSP retten
  882. noSF1:  MOVE.L  USP,A2
  883.         MOVE.L  A2,-(A1)        ; USP retten
  884.         MOVE.L  A7,-(A1)        ; SSP retten
  885.         MOVE.L  A1,stackhi
  886.         MOVE.L  A1,USP          ; den regStack auch für Malloc-Aufruf nutzen
  887.         ANDI    #$CFFF,SR       ; User Mode aktivieren
  888.  
  889.         ; Stack f. Modula-Funktionen (Loader-Aufruf) reservieren
  890.         MOVE.L  A0,-(A7)
  891.         MOVE.L  #LoaderStackSize,-(A7)
  892.         MOVE    #$48,-(A7)      ; Malloc()
  893.         TRAP    #1
  894.         ADDQ.L  #6,A7
  895.         MOVE.L  (A7)+,A0
  896.         MOVE.L  D0,A3
  897.         LEA     LoaderStackSize(A3),A7
  898.  
  899.         ; Parameter für 'hdlPexec' auf den Parm-Stack (A3) laden
  900.         MOVE.L  A0,(A3)+        ; Adr. der Parameter übergeben
  901.         LEA     exitCode(PC),A0
  902.         MOVE.L  A0,(A3)+        ; Adr. der exitCode-Variable übergeben
  903.         MOVE    #1,doingPexec   ; Flag gegen Wiedereintritt setzen
  904.         JSR     hdlPexec        ; Pexec-Sonderbehandlung
  905.         CLR.W   doingPexec
  906.         MOVE.W  -(A3),D0        ; Pexec-Rückgabewert (BOOLEAN = 2 Byte)
  907.  
  908.         ; Modula-Stack wieder freigeben
  909.         MOVE.L  stackhi,A7      ; regStack wieder für SP verwenden
  910.         MOVE.W  D0,-(A7)
  911.         MOVE.L  A3,-(A7)
  912.         MOVE    #$49,-(A7)      ; Mfree()
  913.         TRAP    #1
  914.         ADDQ.L  #6,A7
  915.         
  916.         ; zurück in den Supervisor-Mode:
  917.         CLR.L   -(A7)
  918.         MOVE    #$20,-(A7)      ; Super (0L)
  919.         TRAP    #1
  920.         ADDQ.L  #6,A7
  921.         MOVE.W  (A7)+,D0
  922.         
  923.         MOVE.L  A7,A1
  924.         MOVE.L  (A1)+,A7        ; SSP zurück
  925.         MOVE.L  (A1)+,A0        ; USP zurück
  926.         MOVE.L  A0,USP
  927.         TST.W   stackFrameOffs  ; StackFrame vorhanden?
  928.         BEQ     noSF2           ; nein
  929.         MOVE.W  (A1)+,-(A7)     ; StackFrame zurück
  930. noSF2:  MOVE.L  (A1)+,-(A7)     ; PC zurück
  931.         MOVE.W  (A1)+,-(A7)     ; SR zurück
  932.         MOVEM.L (A1)+,D1-D7/A2-A6
  933.         MOVE.L  A1,stackhi
  934.  
  935.         TST.W   D0              ; hdlPexec-Rückgabewert prüfen
  936.         BEQ     dos             ; Wurde nicht ausgeführt -> GEMDOS aufrufen
  937.         
  938.         MOVE.L  exitCode(PC),D0 ; Exitcode laden
  939.         RTE                     ; und zurück zum Aufrufer
  940.  
  941. exitCode: DS    4               ; 4 Byte für Exitcode reservieren
  942.     END
  943.   END hdlGemdos;
  944.   (*$L=*)
  945.  
  946. PROCEDURE readInfFile;
  947.   (*
  948.    * Liest die Datei "MODLOAD.INF" und lädt die darin angegebenen Module.
  949.    *)
  950.   
  951.   VAR f: File;
  952.       s: Strings.String;
  953.       msg: ARRAY [0..99] OF CHAR;
  954.       result: LoaderResults;
  955.   
  956.   BEGIN
  957.     s:= 'MODLOAD.INF';
  958.     ShellFind (s);
  959.     IF NOT GemError () THEN
  960.       MyPaths.init; (* Suchpfade setzen *)
  961.       Open (f, s, readSeqTxt);
  962.       WHILE NOT EOF (f) DO
  963.         ReadString (f, s);        (* String am Zeilenbeginn einlesen *)
  964.         ReadLn (f);               (* Zeilenende überlesen *)
  965.         LoadModule (s, MyPaths.paths, s, msg, result) (* Datei laden *)
  966.       END;
  967.       Close (f);
  968.       MyPaths.exit
  969.     END
  970.   END readInfFile;
  971.   
  972. PROCEDURE initMsg;
  973.   BEGIN
  974.     Alert ('ModLoad 1.4 is installed. Written by Thomas Tempelmann with Megamax Modula-2', FALSE);
  975.   END initMsg;
  976.  
  977. VAR termwsp: MemArea;
  978.     pdb: PtrPDB;
  979.     pr: ADDRESS;
  980.     msg: MessageBuffer;
  981.     menuID: CARDINAL;
  982.  
  983. BEGIN
  984.   IF UseStackFrame () THEN stackFrameOffs:= 2 ELSE stackFrameOffs:= 0 END;
  985.   baseProcess:= ProcessID^;
  986.   doingPexec:= FALSE;
  987.   DefaultStackSize:= 16000;
  988.   (* 'hdlGemdos' in TRAP #1 einhängen *)
  989.   IF NOT XBRA.Installed (Kennung, $84 (* GEMDOS/TRAP#1 *), at) THEN
  990.     XBRA.Create (carrier, Kennung, CAST (ADDRESS, hdlGemdos), entry);
  991.     XBRA.Install (entry, at);
  992.     stackhi:= ADR (regStack) + SIZE (regStack);
  993.     GetPDB (pdb, pr);
  994.     myUpperName:= MyName;
  995.     Strings.Upper (myUpperName);
  996.     IF NOT Accessory () THEN
  997.       Alert ('PrgLoad läuft nur als Accessory!', TRUE)
  998.     ELSE
  999.       InitApplication (ok);
  1000.       IF NOT ok THEN HALT END;
  1001.       RegisterAcc (CADR ("  "+MyName), menuID, ok);
  1002.       UpdateWindow (TRUE);
  1003.       readInfFile;
  1004.       UpdateWindow (FALSE);
  1005.       LOOP
  1006.         MessageEvent (msg);
  1007.         IF (msg.msgType = accOpen) THEN
  1008.           initMsg;
  1009.         END
  1010.       END
  1011.     (*
  1012.     ELSE
  1013.       (* resident installieren *)
  1014.       termwsp.bottom:= NIL;
  1015.       InstallModule (release, termwsp);        (* Modul resident machen *)
  1016.       readInfFile;
  1017.       initMsg;
  1018.     *)
  1019.     END
  1020.   END
  1021. END ModLoad.
  1022.